COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	FORSER - service routines - ISIGN, SIGN, DISX, DISY, AMOD
C00006 00003	_ KARN
C00009 00004	_ KARN cont.-	Check for collinear case, if switch is on.
C00011 00005	_ KARN cont
C00020 ENDMK
C⊗;
COMMENT	FORSER - service routines - ISIGN, SIGN, DISX, DISY, AMOD;

ENTRY ISIGN,SIGN,KARN,DISX,DISY,AMOD;

BEGIN "FORSER"
DEFINE  QEP="EXTERNAL SIMPLE PROCEDURE",
	QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
	QR="REAL", QRR="REFERENCE REAL",
	_="COMMENT";

EXTERNAL INTEGER DRX,DRY,IX1,IX2,IP1,IP2;
EXTERNAL REAL IRX,IRY,DSCX,DSCY,A11,A12,A21,A22,X00,Y00,RWIC,X,Y,R1,R2;
QEP REKOP(QR R,S,T,U,V; QRR W);

_ return I with the sign of J (integer values);

INTERNAL SIMPLE INTEGER PROCEDURE ISIGN(INTEGER I,J);
	START_CODE
	MOVM 1,I;
	SKIPGE J;
	MOVNS 1;
	END;

_ return R with the sign of S (real values);

INTERNAL SIMPLE REAL PROCEDURE SIGN(REAL R,S);
	RETURN(IF S<0. THEN -(ABS R) ELSE ABS R);

_	Transforms coordinates from internal to display.;

INTERNAL SIMPLE INTEGER PROCEDURE DISX(REAL X);
	RETURN(0.5+DRX+DSCX*(X-IRX));

INTERNAL SIMPLE INTEGER PROCEDURE DISY(REAL Y);
	RETURN(0.5+DRY+DSCY*(Y-IRY));

_	returns real R mod S;

INTERNAL SIMPLE REAL PROCEDURE AMOD(REAL R,S);
	START_CODE DEFINE FIX="'247000000000";
	LABEL L1;
	MOVE 1,R;
	CAMGE 1,S;
	JRST L1;
	MOVE 2,1;
	FDVR 2,S;
	FIX 2,'233000;
	FSC 2,'233;
	FMPR 2,S;
	FSBR 1,2;
L1:	END;
_ KARN;

_	Finds intersection (X1,Y1)-(X2,Y2) X (X3,Y3)-(X4,Y4) = (X,Y).
	IXN ← 1 (else 2) iff line N is closer in slope to X- than to Y-axis.
	IPN ← End on line N, which is closest to (X,Y). IPN ← 1 or 2.
	IPN is negated iff (X,Y) is actually inside line-segment N.
	RN  ← Squared distance from that end to (X,Y). IPN ← 0, and
	RN ← 900000., iff there is no intersection (slopes are too close).
	If the lines are collinear (exception to last sentence), and we
	ask for that case, the center point between their close ends is
	returned as the point of intersection (and other parameters are set
	accordingly). IC defines what is to be done, as follows:

	IC =  0	  Both cases are treated equally.
	IC = -1   Looks for collinearities only.
	IC =  1   Looks for intersections only.

	KARN returns  0 iff lines are  parallel, but not collinear,
		     -1 iff lines are collinear, and
		      1 iff lines intersect somewhere.
		 -(1+N) iff line N (i or 2) is gobbled by line (2-N).;


INTERNAL SIMPLE INTEGER PROCEDURE KARN(REAL X1,Y1,X2,Y2,X3,Y3,X4,Y4;
	 	INTEGER IC);
	BEGIN "KARN"
	LABEL L70,L71,L710,L1,L10,L11,L110,L2,L3,L5,L6,L13,L12,L14;
	REAL YD1,YD2,XD1,XD2,XP,YP,XQ,YQ,RDUM,AK1,AK2,DK,D1,D2,S1,S2,XA,YA,
		XB,YB;
	INTEGER IRET,GOBBLE;

	IRET←GOBBLE←0;
	IX1←IX2←1;
	IP1←IP2←0;
	R1←R2←900000.;
	YD1←Y1-Y2;
	YD2←Y3-Y4;
	XD1←X1-X2;
	XD2←X3-X4;
	IF ABS YD1 > ABS XD1 THEN IX1←2;
	IF ABS YD2 > ABS XD2 THEN IX2←2;
_ KARN cont.-	Check for collinear case, if switch is on.;

	IF IC=1 THEN GO L1;
	D1←0.25*(X1+X2+X3+X4);
	D2←0.25*(Y1+Y2+Y3+Y4);
	XP←X1;
	YP←Y1;
	IF (XP-D1)↑2+(YP-D2)↑2≤(X2-D1)↑2+(Y2-D2)↑2 THEN GO L70;
	XP←X2;
	YP←Y2;
L70:	XQ←X3;
	YQ←Y3;
	XA←X1+X2-XP;
	YA←Y1+Y2-YP;
	IF (XA-XQ)↑2+(YA-YQ)↑2≤(XA-X4)↑2+(YA-Y4)↑2 THEN GO L71;
	XQ←X4;
	YQ←Y4;

_	If lines are anywhere near collinear, (XP,YP) and (XQ,YQ) are
	the coordinates of the closest ends.;

L71:	XB←X3+X4-XQ;
	YB←Y3+Y4-YQ;

_	First check if either line might overlap the other entirely.;

	D1←XD1↑2+YD1↑2;
	D2←XD2↑2+YD2↑2;
	IF (RDUM←(XA-XB)↑2+(YA-YB)↑2)<D1∨RDUM<D2 THEN IF D1<D2 THEN
		BEGIN
		XP←X1;
		YP←Y1;
		XQ←X2;
		YQ←Y2;
		XA←X3;
		YA←Y3;
		XB←X4;
		YB←Y4;
		GOBBLE←1
		END ELSE BEGIN
		XP←X3;
		YP←Y3;
		XQ←X4;
		YQ←Y4;
		XA←X1;
		YA←Y1;
		XB←X2;
		YB←Y2;
		GOBBLE←2
		END;
    	X←X3+X4-XQ;
	Y←Y3+Y4-YQ;
_ KARN cont;

_	OK. Now set up the rectangular operator coordinate transform.;

	REKOP(XA,YA,XB,YB,RWIC,RDUM);

_	Use the transform for the elliptic operator test.;

	IF (A11*(XP-X00)+A12*(YP-Y00))↑2+(A21*(XP-X00)+A22*(YP-Y00))↑2≤1.∧
	   (A11*(XQ-X00)+A12*(YQ-Y00))↑2+(A21*(XQ-X00)+A22*(YQ-Y00))↑2≤1.
		THEN IF GOBBLE THEN RETURN(-1-GOBBLE) ELSE IRET←-1;

_	If lines are not collinear, and IC=0, try intersection.;

L710:	IF IRET+IC=0 THEN GO L1;

_	If lines are not collinear, but IC=-1, we return.;

	IF IRET=0 THEN RETURN(IRET);

_	Lines are collinear. IC=0 or IC=-1. In either case, update parameters
	to be returned, using intersection case, and then exit.;

	X←0.5*(XP+XQ);
	Y←0.5*(YP+YQ);
	GO L110;

L1:	AK1←1000.;
	IF ABS XD1 > 0.005 THEN AK1←YD1/XD1;
	IF ABS AK1 > 1000. THEN AK1←1000.;
	AK2←1000.;
	IF ABS XD2 > 0.005 THEN AK2←YD2/XD2;
	IF ABS AK2 > 1000. THEN AK2←1000.;
	IF ABS AK1 > 50. ∧ ABS AK2 > 50. THEN RETURN(IRET);
	DK←AK1-AK2;
	IF ABS DK < 0.2 THEN RETURN(IRET);
	X←(AK1*X1-Y1+Y3-AK2*X3)/DK;
	IF X<-50.∨X>360. THEN RETURN(IRET);
	IF ABS AK1 < ABS AK2 THEN GO L10;
	Y←Y3+AK2*(X-X3);
	GO L11;

L10:	Y←Y1+AK1*(X-X1);
L11:	IF Y<-50.∨Y>290. THEN RETURN(IRET);
	IRET←1;
L110:	IF IX1=2 THEN GO L2;
	D1←X-X1;
	D2←X-X2;
	GO L3;

L2:	D1←Y-Y1;
	D2←Y-Y2;
L3:	S1← ABS D1 - ABS D2;
	S2←D1*D2;
	IP1←2;
	IF S1<0. THEN IP1←1;
	IF S2<0. THEN IP1←-IP1;
	IF IX2=2 THEN GO L5;
	D1←X-X3;
	D2←X-X4;
	GO L6;

L5:	D1←Y-Y3;
	D2←Y-Y4;
L6:	S1← ABS D1 - ABS D2;
	S2←D1*D2;
	IP2←2;
	IF S1<0. THEN IP2←1;
	IF S2<0. THEN IP2←-IP2;
	IF ABS IP1 = 2 THEN GO L13;
	R1←(X-X1)↑2+(Y-Y1)↑2;
	GO L12;

L13:	R1←(X-X2)↑2+(Y-Y2)↑2;
L12:	IF ABS IP2 = 2 THEN GO L14;
	R2←(X-X3)↑2+(Y-Y3)↑2;
	RETURN(IRET);

L14:	R2←(X-X4)↑2+(Y-Y4)↑2;
	RETURN(IRET)
	END "KARN";

	END "FORSER";